home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
tsfaqp35.zip
/
FAQPAS4.TXT
< prev
next >
Wrap
Internet Message Format
|
1996-11-09
|
51KB
From ts@uwasa.fi Sat Nov 9 00:00:00 1996
Subject: FAQPAS4.TXT contents
Copyright (c) 1993-1996 by Timo Salmi
All rights reserved
FAQPAS4.TXT The fourth set of frequently (and not so frequently)
asked Turbo Pascal questions with Timo's answers. The items are in
no particular order.
You are free to quote brief passages from this file provided you
clearly indicate the source with a proper acknowledgment.
Comments and corrections are solicited. But if you wish to have
individual Turbo Pascal consultation, please post your questions to
a suitable Usenet newsgroup like news:comp.lang.pascal.borland. It
is much more efficient than asking me by email. I'd like to help,
but I am very pressed for time. I prefer to pick the questions I
answer from the Usenet news. Thus I can answer publicly at one go if
I happen to have an answer. Besides, newsgroups have a number of
readers who might know a better or an alternative answer. Don't be
discouraged, though, if you get a reply like this from me. I am
always glad to hear from fellow Turbo Pascal users.
....................................................................
Prof. Timo Salmi Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi archives 193.166.120.5
Department of Accounting and Business Finance ; University of Vaasa
ts@uwasa.fi http://uwasa.fi/~ts BBS 961-3170972; FIN-65101, Finland
--------------------------------------------------------------------
76) What are the current Pascal newsgroups on the Usenet news?
77) How do I detect the CapsLock status, how do I turn it on/off?
78) How do I detect if the F11 or F12 key has been pressed?
79) How do I extract (parse) substrings from an input string?
80) How do I find out the size of any kind of a file?
81) How do I format graphics output like in textmode writeln?
82) How do I detect if more than one standard key is pressed down?
83) How can I read a disk's Volume Serial Number?
84) How can I disable and then enable the keyboard in my TP program?
85) How do I get the character device name of the (first) CD-ROM?
86) How do I eject a CD-ROM using a Turbo Pascal program?
87) How do I find out if the ANSI.SYS driver has been loaded?
88) Where do I find Turbo Pascal tutorials and/or good textbooks?
89) How do I make an executable of my Turbo Pascal source program?
90) How can I quickly read the last byte of a file?
91) Is 2000 a leap year? What is the leap year algorithm?
92) Does anybody have a program that gives the week number?
93) How can I use OutText to write numbers in the graphics mode?
94) How can I redirect output to file if I use the Crt unit?
95) How to write a function to return true if I am in graphics mode?
96) My graph.tpu got corrupted. Someone please email me a new copy.
97) How can I avoid run-time errors in numeric input using readln?
98) How can I limit the user's readln input to e.g. 3 characters?
99) Can you tell a beginner how to delete files with Turbo Pascal?
100) Could you please explain shl and shr operators to a beginner?
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:16 1996
Subject: Usenet Pascal newsgroups
76. *****
Q: What are the current Pascal newsgroups on the Usenet news?
A: The following new Pascal newsgroups were created June 12, 1995
to replace the old comp.lang.pascal. The new Delphi newsgroups were
first created around July 10, 1995. Further Delphi newsgroups were
added in April 1996.
A special note about Delphi postings. Please use the delphi
newsgroups for the Delphi related postings. In particular, the
newsgroup comp.lang.pascal.borland is _NOT_ for Delphi related
subjects!
A second special note. Please avoid crossposting between the
newsgroups. In particular do not crosspost between the old and the
new newsgroups. It slows the transition to the new system. (This
automatic posting breaches the general non-crossposting tenet only
because it is relevant information about the arrangements of all the
newsgroups involved.)
CURRENT:
comp.lang.pascal.ansi-iso Pascal according to ANSI and ISO standards.
comp.lang.pascal.borland Borland's Pascal incl. Turbo Pascal (not Delphi!)
comp.lang.pascal.mac Macintosh based Pascals.
comp.lang.pascal.misc Pascal in general and ungrouped Pascals.
comp.lang.pascal.delphi.advocacy Contentious issues related to Delphi.
comp.lang.pascal.delphi.announce Delphi related announcements. (Moderated)
comp.lang.pascal.delphi.components.misc General component issues.
comp.lang.pascal.delphi.components.usage Using pre-written components.
comp.lang.pascal.delphi.components.writing Writing Delphi components.
comp.lang.pascal.delphi.databases Database aspects of Borland Delphi.
comp.lang.pascal.delphi.misc General issues with Borland Delphi.
comp.sources.delphi Delphi and ObjectPascal source code. (Moderated)
RELATED of potential interest:
comp.os.msdos.programmer.turbovision Borland's text application libraries
OLD: Please cease using!
comp.lang.pascal Discussion about Pascal.
comp.lang.pascal.delphi.components Writing components in Borland Delphi.
For more information about the Pascal newsgroups please see
52703 Jun 14 1995 ftp://garbo.uwasa.fi/pc/doc-net/pasgroup.zip
pasgroup.zip Information about the comp.lang.pascal.* newsgroups
If your site is not getting the new Pascal newsgroups, please
contact your own site's newsmaster about the situation.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:17 1996
Subject: Capslock status and toggling
77. *****
Q: How do I detect the CapsLock status, how do I turn it on/off?
A: Here are the relevant Turbo Pascal routines in answer to these
questions.
{}
Uses Dos; { The Dos unit is needed }
{}
(* Is CapsLock on *)
function CAPSONFN : boolean;
var regs : registers;
KeyStatus : byte;
begin
FillChar (regs, SizeOf(regs), 0);
regs.ax := $0200; { Get shift flags }
Intr ($16, regs); { The keyboard interrupt }
KeyStatus := regs.al; { AL = shift status bits }
if (KeyStatus and $40) > 0 then { bit 6 }
capsonfn := true
else
capsonfn := false;
end; (* capsonfn *)
{}
(* Set CapsLock. Use true to turn on, false to turn off *)
procedure CAPS (TurnOn : boolean);
var keyboardStatus : byte absolute $0040:$0017;
regs : registers;
begin
if TurnOn then
keyboardStatus := keyboardStatus or $40
else
keyboardStatus := keyboardStatus and $BF;
{ Interrrupt "check for keystroke" to ensure the LED status }
FillChar (regs, SizeOf(regs), 0);
regs.ah := $01;
Intr ($16, regs);
end; (* caps *)
{}
As you see, CapsLock is indicated by bit 6. The other toggles can be
handled in an equivalent way using this information about the memory
location Mem[$0040:$0017]:
ScrollLock = bit 4 $10 $EF
NumLock = bit 5 $20 $DF
CapsLock = bit 6 $40 $BF
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:18 1996
Subject: Detecting F11 and F12
78. *****
Q: How do I detect if the F11 or F12 key has been pressed?
A: Here is a sample program
uses Dos;
(* Enhanced keyboard ReadKey, no Crt unit needed. Detects also F11
and F12, and distinguishes between the numeric keypad and the
gray keys. Lower part of the word returns the first scan code,
the higher part the second *)
function RDENKEFN : word;
var regs : registers;
keyboard : byte absolute $40:$96;
begin
rdenkefn := 0;
if ((keyboard shr 4) and 1) = 0 then exit;
FillChar (regs, SizeOf(regs), 0);
regs.ah := $10;
Intr ($16, regs);
rdenkefn := regs.ax;
end; (* rdenkefn *)
{}
procedure TEST;
var key : word;
begin
while Lo(key) <> 27 do { esc exits }
begin
key := RDENKEFN;
if (Lo(key) = 0) and (Hi(key) = 133) then
writeln ('F11 was pressed');
if (Lo(key) = 0) and (Hi(key) = 134) then
writeln ('F12 was pressed');
end;
end;
{}
begin TEST; end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:19 1996
Subject: Substrings from a string
79. *****
Q: How do I extract (parse) substrings from an input string?
A: Carefully study these two routines which I have included in
23480 Apr 21 1996 ftp://garbo.uwasa.fi/pc/research/simirr11.zip
simirr11.zip Deriving IRR from ARR: A Simulation Testbench, TS+IV
They use space (and anything in ascii below it) as the separator.
Change the while tests if you wish to have a different set of
separators.
(* Number of substrings in a string *)
function PARSENFN (sj : string) : integer;
var i, n, p : integer;
begin
p := Length(sj);
n := 0;
i := 1;
repeat
while (sj[i] <= #32) and (i <= p) do Inc(i);
if i > p then begin parsenfn := n; exit; end;
while (sj[i] > #32) and (i <= p) do Inc(i);
Inc(n);
if i > p then begin parsenfn := n; exit; end;
until false;
end; (* parsenfn *)
{}
(* Get substrings from a string *)
function PARSERFN (sj : string; PartNumber : integer) : string;
var i, j, n, p : integer;
stash : string;
begin
if (PartNumber < 1) or (PartNumber > PARSENFN(sj)) then
begin PARSERFN := ''; exit; end;
p := Length(sj);
n := 0;
i := 1;
repeat
while (sj[i] <= #32) and (i <= p) do Inc(i);
Inc(n);
if n = PartNumber then
begin
j := 0;
while (sj[i] > #32) and (i <= p) do
begin
Inc(j);
stash[0] := chr(j);
stash[j] := sj[i];
Inc(i);
end;
PARSERFN := stash;
exit;
end
else
while (sj[i] > #32) and (i <= p) do Inc(i);
until false;
end; (* parserfn *)
{}
{... A separate, but useful function from the same package ...}
(* Delete trailing white spaces etc rubble from a string *)
function TRAILFN (sj : string) : string;
var i : byte;
begin
i := Length (sj);
while (i > 0) and (sj[i] <= #32) do i := i - 1;
sj[0] := chr(i); trailfn := sj;
end; (* trailfn *)
{}
{... Another separate, but useful function from the same package ...}
(* Delete leading white spaces etc subble from a string *)
function LEADFN (sj : string) : string;
var i, p : byte;
begin
p := Length (sj); i := 1;
while (i <= p) and (sj[i] <= #32) do i := i + 1;
leadfn := Copy (sj, i, p-i+1);
end; (* leadfn *)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:20 1996
Subject: Size of a file
80. *****
Q: How do I find out the size of any kind of a file?
A1: Well, to begin with the FileSize keyword and an example code
are given in the manual (and help function of later TP versions) so
those, as usual, are the first places to look at. But the example
solution can be somewhat improved, and there is also an alternative
solution. The FSIZEFN should never be applied on an open file.
function FSIZEFN (filename : string) : longint;
var fle : file of byte; { declare as a file of byte }
fmSave : byte;
begin
fmSave := FileMode; { save the current filemode }
FileMode := 0; { to handle also read-only files }
assign (fle, filename);
{$I-} reset (fle); {$I+} { to do your own error detection }
if IOResult <> 0 then begin
fsizefn := -1; FileMode := fmSave; exit;
end;
fsizefn := FileSize(fle);
close (fle);
FileMode := fmSave; { restore the original filemode }
end; (* fsizefn *)
A2: The second, general alternative is
uses Dos;
function FSIZE2FN (FileName : string) : longint;
var FileInfo : SearchRec; { SearchRec is declared in the Dos unit }
begin
fsize2fn := -1; { return -1 if anything goes wrong }
FindFirst (filename, AnyFile, FileInfo);
if DosError <> 0 then exit;
if (FileInfo.Attr and VolumeId = 0) and
(FileInfo.Attr and Directory = 0) then
fsize2fn := FileInfo.Size;
end; (* fsize2fn *)
A3: The third alternative is due to a Usenet posting by Wayne
Hoxsie (hoxsiew@crl.com). This alternative is an instructive example
of using file handles.
uses dos;
var f : file;
{}
function filelength (var f : file) : longint;
var
handle : ^word;
regs : registers;
begin
handle := @f;
fillchar (regs, SizeOf(regs), 0); { just in case }
regs.ax := $4202;
regs.bx := handle^;
regs.cx := 0;
regs.dx := 0;
msdos(regs);
filelength := (longint(regs.dx) SHL 16)+regs.ax;
end;
{}
begin
assign(f,paramstr(1));
filemode := 0; { read-only files too }
reset(f);
writeln(filelength(f));
close(f);
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:21 1996
Subject: Formatting graphics output
81. *****
Q: How do I format graphics output like in textmode writeln?
A: In the graphics mode the positioned text output procedure is
OutTextXY (X ,Y : integer; TextString : string); It does not have
the same output formatting capabilities as the write procedure. It
only accepts the one TextString. Therefore all the output formatting
must be done previously on the string. The Str procedure has such
capabilities. The example below gives the rudiments.
uses Crt, Graph;
var grDriver : integer;
grMode : integer;
ErrCode : integer;
s, s1 : string;
v1 : real;
begin
grDriver := Detect;
InitGraph (grDriver, grMode, ' ');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
ClearDevice;
{}
{ Writing text in the graphics mode }
{ Set the drawing color }
SetColor (Yellow);
{ Set the current background color }
SetBkColor (Black);
{ Set style for text output in graphics mode }
SetTextStyle (DefaultFont, HorizDir, 2);
{ Preprocess the text }
v1 := 2.345;
Str (v1 : 10:2, s1);
s := 'The first value is' + s1 + '.';
{ Output the text }
OutTextXY (100, 30, s);
OutTextXY (100, 50, 'Press any key');
{}
repeat until KeyPressed;
{}
RestoreCrtMode;
writeln ('That''s all folks');
CloseGraph;
end.
Besides not having the same output formatting capabilities OutTextXY
and OutText procedures do not scroll the screen. If you wish to
achieve such an effect, you will have to code it yourself step by
step. You can see the effect in
111673 Oct 8 1993 ftp://garbo.uwasa.fi/pc/ts/tsdemo16.zip
tsdemo16.zip Assorted graphics demonstrations of functions etc
Coding the scrolling is a straight-forward but a laborious task.
Hence it is beyond this FAQ. The outline, however, is that you must
keep track where on the screen you are. When you come to the bottom
of your window you have to move the above region upwards before you
output new text. You can move graphics regions using the ImageSize,
GetImage and PutImage procedures.
As for readln-type input in a graphics mode, that is a complicated
issue. You will have to build the input routine reading a character
at a time with ReadKey. The rudiments of using ReadKey are shown in
the first question of FAQPAS.TXT. The demo, referred to a few lines
back, will show the effect.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:22 1996
Subject: Reading more than one key
82. *****
Q: How do I detect if more than one standard key is pressed down?
A: The example code below relies very heavily on a Usenet posting
by Lou Duchez ljduchez@en.com who wishes to acknowledge Bill Seiler
for the handling of ports. The KeyNrDown and TEST routines are by
myself. Besides being a demonstration the TEST procedure can be used
to get the scan codes of the different keys instead of relying on
external documentation.
Uses Dos;
{}
var keydown: array[0..127] of boolean; { status array }
oldkbdint: procedure; { points to the "normal" keyboard handler }
port60h, port61h: byte; { used within the interrupt for storage }
{}
{ The replacement keyboard handler }
procedure newkbdint; interrupt;
begin
port60h := port[$60];
keydown[port60h and $7f] := (port60h <= $7f);
port61h := port[$61];
port[$61] := port61h or $80;
port[$61] := port61h;
port[$20] := $20;
end;
{}
{ Get the scancode of the key pressed down, 128 for none }
function KeyNrDown : byte;
var i : byte;
begin
KeyNrDown := 128;
for i := 0 to 127 do if KeyDown[i] then KeyNrDown := i;
end;
{}
{ Test by displaying the scan codes of the keys pressed }
procedure TEST;
var k, k1 : byte;
begin
k1 := 128;
repeat
k := KeyNrDown;
if k <> k1 then begin
write (k, ' ');
if (k1 = 30) and (k = 31) then writeln ('Pressed A and S ');
k1 := k;
end;
until k = $01; {escape}
end; {test}
{}
begin
{ turn on the replacement keyboard handler }
fillchar(keydown, 128, #0); { sets array to all "false" }
getintvec($09, @oldkbdint); { record location of old keyboard int }
setintvec($09, @newkbdint); { this line installs the new interrupt }
{}
TEST;
{}
{ turn off the replacement keyboard handler }
setintvec($09, @oldkbdint);
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:23 1996
Subject: Volume Serial Number
83. *****
Q: How can I read a disk's Volume Serial Number?
A: The Volume Serial Number for disks was introduced in MS-DOS
version 4.0. Here is an example code
uses Dos;
{}
(* Convert a longint to a hexadecimal string *)
function LHEXFN (decimal : longint) : string;
const hexDigit : array [0..15] of char = '0123456789ABCDEF';
var i : byte;
hexString : string;
begin
FillChar (hexString, SizeOf(hexString), ' ');
hexString[0] := chr(8);
for i := 0 to 7 do
hexString[8-i] := HexDigit[(decimal shr (4*i)) and $0F];
lhexfn := hexString;
end; (* lhexfn *)
{}
(* Get disk serial number. Requires MS-DOS 4.0+.
Else, or on an error, returns an empty string.
The default drive can be pointed to by using '0' *)
function GETSERFN (drive : char) : string;
type diskInfoRecordType =
record
infoLevel : word; { zero }
serialNumber : longint; { DWORD actually }
volumeLabel : array [1..11] of char; { NO NAME if none present }
filesystemType : array [1..8] of char; { FAT12 or FAT16 }
end;
var regs : registers;
diskInfo : diskInfoRecordType;
serial : string;
begin
getserfn := '';
if swap(DosVersion) < $0400 then exit;
FillChar (regs, SizeOf(regs), 0);
drive := UpCase (drive);
if drive <> '0' then if (drive < 'A') or (drive > 'Z') then exit;
regs.ah := $69; { Interrrupt 21 function $69 }
regs.al := $00; { subfunction: get serial number }
if drive <> '0' then
regs.bl := ord(drive) - ord('A') + 1
else regs.bl := 0;
regs.ds := Seg(diskInfo); { the diskInfo address: }
regs.dx := Ofs(diskInfo); { its segment and offset }
Intr ($21, regs);
if (regs.flags and FCarry) <> 0 then exit; { CF is set on error }
serial := LHEXFN (diskInfo.serialNumber);
getserfn := Copy (serial, 1, 4) + '-' + Copy (serial, 5, 4);
end; (* getserfn *)
{}
begin
writeln ('C: ', GETSERFN('C'));
end.
A2: The second alternative has been modified from a posting by
Robert B. Clark rclark@su1.in.net. I have also utilized INTERRUP.E
from Ralf Brown's listing of interrupt calls
ftp://garbo.uwasa.fi/pc/programming/inter52b.zip
{}
uses Dos;
function GETSERFN2 (drive : char): longint;
var ParBlock : array [0..24] of char; { IOCTL parameter block Table 0785 }
regs : registers;
sernum : longint;
begin
FillChar (ParBlock, SizeOf(ParBlock), 0);
FillChar (regs, SizeOf(regs), 0);
regs.ax := $440D; { IOCTL - generic block device request }
if drive <> '0' then { '0' points to the default drive }
regs.bl := ord(UpCase(drive)) - ord('A') + 1 { drive as byte }
else regs.bl := 0;
regs.ch := $08; { block device IOCTL category code: disk drive }
regs.cl := $66; { IOCTL minor code: get volume serial number }
regs.ds := Seg(ParBlock); { Parameter block segment address }
regs.dx := Ofs(ParBlock); { Parameter block offset }
MsDos (regs); { Call interrupt $21 }
if regs.Flags and FCarry = 0 then
sernum := word(ord(ParBlock[4]) + ord(ParBlock[5]) shl 8) * 65536 +
word (ord(ParBlock[2]) + ord(ParBlock[3]) shl 8)
else sernum := 0;
getserfn2 := sernum;
end; (* getsetfn2 *)
{}
begin
writeln ('C: ', LHEXFN(GETSERFN2('0')));
end.
A3: Setting a disk's serial number, instead of just reading it, is
more complicated and will not be covered here. If you need it, the
routine without source code is available (for floppies only for
security reasons) as
"SETSER Set floppy's serial number (MS-DOS 4.0+)"
in TSUNTK.TPU in ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:24 1996
Subject: Disabling the keyboard
84. *****
Q: How can I disable and then enable the keyboard in my TP program?
A: Here is the code. A warning! Don't experiment with ports. You
can do real harm to your data and your computer if you do not know
exactly what you are doing.
uses Dos, Crt; { Crt only needed because of 'Delay' in the testing }
var i : byte; { only needed in the testing }
NormalKeyboard : procedure;
{}
procedure DisableKeyboard; interrupt;
var port60, port61 : byte;
begin
port60 := Port[$60]; { KeyBoard controller data output buffer }
port61 := Port[$61]; { Keyboard controller port B }
Port[$61] := Port61 or $80; { clear keyboard }
Port[$61] := Port61;
Port[$20] := $20; { Programmable Intr. Contr. initialization }
end;
{}
begin
writeln ('Testing...');
GetIntVec ($09, @NormalKeyboard);
SetIntVec ($09, @DisableKeyboard);
write ('The keyboard is now disabled..');
for i := 1 to 5 do begin
Delay (1000);
write (i:2);
end; {for}
writeln;
SetIntVec ($09, @NormalKeyboard);
write ('The keyboard is now enabled...');
for i := 1 to 5 do begin
Delay (1000);
write (i:2);
end; {for}
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:25 1996
Subject: CD-ROM device name
85. *****
Q: How do I get the character device name of the (first) CD-ROM?
A: First the code for a quick and dirty method to find the
character device name
function MSCDEXFN : string;
var s : string;
f : text;
i : byte;
fmSave : byte;
begin
mscdexfn := ''; { To indicate not found }
fmSave := FileMode; { Store the original file mode }
FileMode := 0; { Also if read-only }
Assign (f, 'c:\autoexec.bat'); { Browse the AUTOEXEC.BAT }
{$I-} Reset (f); {$I+}
if IOResult <> 0 then exit; { AUTOEXEC.BAT not found }
while not eof(f) do begin { Line by line }
readln (f, s);
for i := 1 to Length(s) do s[i] := Upcase(s[i]);
if Pos('MSCDEX', s) > 0 then begin { Is this the line }
if Pos ('REM', s) = 1 then continue; { Skip rem lines }
Close (f);
FileMode := fmSave; { Restore the original mode }
i := Pos('/D:', s); { Look for the switch }
if i = 0 then exit; { Nah! }
i := i + 3; { Where the name should start }
if i > Length(s) then exit; { Nothing there! }
s := Copy (s, i, 255); { Rest of the line after /D: }
mscdexfn := s;
i := Pos (' ', s);
if i = 0 then exit;
mscdexfn := Copy (s, 1, i-1);
exit; { Don't close twice }
end; {if}
end; {while}
Close (f);
FileMode := fmSave; { Restore the original mode }
end; (* mscdexfn *)
A2: There is more general and orthodox solution to finding the
character device name for the (first)m CD-ROM. This was kindly
provided to me by Chris Rankin (rankin@shfax1.shef.ac.uk).
uses Dos;
function GetCDROMDevice : string;
const driver_name_len = 8;
type
sig = array[1..6] of char;
siglet = array[1..4] of char;
signum = array[1..2] of char;
drvname = array[1..driver_name_len] of char;
driverstr = string[driver_name_len];
type
PCDROMDriver = ^TCDROMDriver;
TCDROMDriver = record
NextDriver: PCDROMDriver;
DeviceAttr: word;
StrategyEntryPoint: word;
INTEntryPoint: word;
DeviceName: drvname;
Reserved: word;
DriveLetter: byte;
Units: byte;
case byte of
0: (SigLetters: siglet;
SigNumbers: signum);
1: (Signature: sig)
end;
TDriveEntry = record
SubUnit: byte;
Driver: PCDROMDriver
end;
var
DeviceList: array[1..26] of TDriveEntry;
Regs: registers;
Name: driverstr;
begin
with Regs do
begin
ax := $1500;
bx := 0;
intr($2f,Regs); (* Ask for number of CD-ROM drives. *)
if bx = 0 then (* If none, then exit. *)
begin
Name[0] := #0;
GetCDROMDevice := Name;
exit
end;
ax := $1501; (* Put information about each CD-ROM *)
es := seg(DeviceList); (* into DeviceList[]. *)
bx := ofs(DeviceList);
intr($2f,Regs)
end; (* Below: Name of first CD-ROM driver *)
Name := DeviceList[1].Driver^.DeviceName;
while Name[length(Name)] = ' ' do (* Strip off trailing blanks.. *)
dec(Name[0]);
GetCDROMDevice := Name
end;
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:26 1996
Subject: Ejecting CD-ROM
86. *****
Q: How do I eject a CD-ROM using a Turbo Pascal program?
A: The code for the ejection is given below. Note that it needs the
MSCDEXFN function from the previous FAQ item.
uses Dos;
{}
procedure EJECT (charDev : string;
var ok : boolean;
var errCode : word);
var regs : registers;
cdrom : file;
cdCtrlBlock : byte; { CD-ROM Control Block }
handle : ^word; { Handle referencing CD-ROM driver }
begin
Assign (cdrom, charDev); { Character device for CD-ROM driver }
{$I-} Reset (cdrom); {$I+} { Tackle errors yourself }
if IOresult <> 0 then begin { Exit if file not found }
ok := false;
errCode := $FFFF; { Your own arbitrary error code }
exit;
end;
FillChar (regs, SizeOf(regs), 0); { Just to make sure }
regs.ax := $4403; { Function $44, subfunction $03 }
handle := @cdrom; { Establish the file handle }
regs.bx := handle^;
FillChar(CdCtrlBlock, SizeOf(CdCtrlBlock), 0);
CdCtrlBlock := $00; { $00 eject disk; $05 close tray }
regs.ds := Seg(CdCtrlBlock); { ds:dx CD-ROM control block }
regs.dx := Ofs(CdCtrlBlock);
MsDos (regs); { Call interrupt $21 }
{$I-} Close (cdrom); {$I+}
ok := regs.flags and FCarry = 0; { Success or not? }
errCode := regs.ax; { $01 = invalid function }
end; { $05 = access denied }
{} { $06 = invalid handle }
procedure TEST; { $0D = invalid data }
var ok : boolean;
code : word;
begin
EJECT ('K', ok, code);
if ok then writeln ('Success') else writeln ('Error ', code);
end;
{}
begin
TEST;
end.
My thanks are due to Miro Wikgren (wikgren@cc.helsinki.fi) who
pointed out that the "handle referencing character device for CD-ROM
driver" must be the name given when the CD-ROM driver is loaded in
CONFIG.SYS and AUTOEXEC.BAT. I could not solve this problem without
that help in comp.lang.pascal.borland. In fact the previous FAQ item
was tackled only after the current FAQ item had been solved first.
A slightly different approach to the file handle by Miro
var cdrom : text; { CD-ROM is a character device }
handle : word; { Handle: word, not a pointer }
:
handle := TextRec(cdrom).handle; { Use TP help for more on this }
regs.bx := handle;
:
Another solution can be found in
3427 Mar 15 1996 ftp://garbo.uwasa.fi/pc/turbopas/cdtips01.zip
cdtips01.zip Eject/Close/Lock/Unlock CD-ROM in TP for Win95, C.Rankin
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:27 1996
Subject: Detecting ANSI.SYS
87. *****
Q: How do I find out if the ANSI.SYS driver has been loaded?
A: The source code of the relevant function is given below.
However, this is not necessarily a good solution. First, it requires
at least MS-DOS version 4.0. Second, there are other, compatible
screen drivers like ZANSI.SYS. You probably are more interested if
such a screen driver has been installed rather than if it is
ANSI.SYS in particular. To find out if any compatible screen driver
is operative use ISANSIFN from TSUNTG.TPU from
ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip
Turbo Pascal 7.0 real mode units for (real:-) programmers
uses Dos;
function ANSIOKFN : boolean;
var regs : registers;
begin
if swap(DosVersion) < $0400 then begin
writeln ('Error: MS-DOS 4+ required');
ansiokfn := false;
halt;
end;
FillChar (regs, SizeOf(regs), 0);
regs.ax := $1A00;
Intr ($2F, regs);
ansiokfn := regs.al = $FF;
end; (* ansiokfn *)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:28 1996
Subject: TP tutorial and books
88. *****
Q: Where do I find Turbo Pascal tutorials and/or good textbooks?
A: I'll list some useful sources. The first one (where also this
item comes from) among other things contains a slightly outdated
list of TP textbooks.
ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip
Common Turbo Pascal Questions and Timo's answers
ftp://garbo.uwasa.fi/pc/turbopas/tptutr11.zip
Glenn Grotzinger's ascii-text Turbo Pascal Tutor
ftp://garbo.uwasa.fi/pc/turbopas/tpr-book.zip
Electronic Turbo Pascal Reference freeware book
ftp://garbo.uwasa.fi/pc/doc-net/faqclpb.zip
comp.lang.pascal.borland newsgroup Mini-FAQ
Furthermore, you should see the fine SWAG (SourceWare Archival
Group's) collection of TP sources. Available from the /pc/turbopas
directory at Garbo. For the current references to the SWAG files see
ftp://garbo.uwasa.fi/pc/INDEX.ZIP.
Yet another useful source can be the Turbo Pascal WWW pages. You
can find some of them by connecting to my WWW home page. Its address
is http://uwasa.fi/~ts. Select my collection of HTTP links and
proceed to the programming section on the link list.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:29 1996
Subject: Making an executable
89. *****
Q: How do I make an executable of my Turbo Pascal source program?
A: This is a typical beginner's frequent question which belies not
having read the manual carefully. You DO have the manual, right? If
you are using Turbo Pascal 7.0 this is explained on page 48 of the
User's Guide in the paragraph "Choosing a destination". Here, in
brief, is what you should do
Press F10 to go to the main menu (or press alt-C)
Choose Compile
Choose Destination Disk (toggle with enter)
To direct where the executable should go
Press F10 to go to the main menu (or press alt-O)
Choose Options
Choose Directories...
Edit the item EXE & TPU directory (the destination directory)
A2: The other alternative is using the TPC i.e. the Command-Line
Compiler. E.g.
tpc -L myprog.pas
For a quick list of the command-line options type tpc alone. For
more information see your friendly manual.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:30 1996
Subject: Last byte of a file
90. *****
Q: How can I quickly read the last byte of a file?
A: Below is the code for a relevant procedure. It has a number of
instructive details for you to look into. It is easy to expand this
procedure into showing any byte counted from the end by substituting
the 1 in Seek (f, fs-1) to the inverted position, and by taking care
that the position is not outside the file.
procedure LASTBYTE (fname : string; var lb : byte);
var f : file; { Use an untyped file designation }
fmSave : byte; { To push and pop the FileMode }
fs : longint; { For file size }
begin
fmSave := FileMode; { Push the original FileMode }
FileMode := 0; { To enable reading also read-only files }
Assign (f, fname);
{$I-} Reset (f, 1); {$I+} { Open file and set record size to 1 }
if IOResult <> 0 then begin
writeln ('Error opening file ', fname);
halt;
end;
fs := FileSize(f); { Get the size of the file }
if fs = 0 then begin
writeln ('Empty file ', fname);
halt;
end;
Seek (f, fs-1); { Position to the last byte of the file }
BlockRead (f, lb, 1); { Read the value of the position into lb }
Close (f); { Close the file }
FileMode := fmSave; { Pop the original FileMode }
end; (* lastbyte *)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:31 1996
Subject: Leap year
91. *****
Q: Is 2000 a leap year? What is the leap year algorithm?
A: With the approaching turn of the century this question is
becoming more and more common. Here is the algorithm in Turbo
Pascal.
function ISLEAP (y : integer) : boolean;
begin
isleap := (y mod 4 = 0) and not ((y mod 100 = 0) and not (y mod 400 = 0));
end; (* isleap *)
My thanks are due to Dr. John Stockton and Associate Professor Seppo
Pynnonen for confirming the result. In fact it was who John
suggested adding this question to the FAQ.
There are several equivalent formulations achieving the same
result. Also nested multi-line if statments could be used. The
boolean statements are much more concise, even if not very easy to
construct.
If you are interested calendar related questions here is one
useful URL reference: ftp://login.dknet.dk/pub/ct/calendar.faq
"Frequentely asked questions about calendars" by Claus Tondering.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:32 1996
Subject: Week number
92. *****
Q: Does anybody have a program that gives the week number?
A1: The first part of the answer comes without source code just
with a pointer to a TPU including a week number algorithm. There is
a function
"WEEKNRFN Returns the week number for a given date"
in the TSUNTE.TPU unit in my
ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip
Turbo Pascal 7.0 real mode units for (real:-) programmers.
(The unit collection is also available for earlier TP versions.)
A2: Below is with permissions the weeknumber source code by Anders
Roar Nielsen aroni@night.ping.dk posted to the Usenet newsgroup
news:comp.lang.pascal.borland by Mark Cole mcole@spuddy.mew.co.uk.
The DayNumber function has been streamlined by Dr. John Stockton.
Only apply on the Gregorian calendar is covered. I do not know if
weekday numbering is internationally standardized or if it is rather
based on national practices.
function FirstThursday (Year: Integer) : Integer;
begin
FirstThursday := 7 - (1 + (Year-1600) + (Year-1597) div 4
- (Year-1501) div 100 + (Year-1201) div 400) mod 7;
end;
function DayNumber (Day, Month, Year : Integer) : Integer;
const
DaysBeforeMonth : array [1..12] of Integer =
(0,31,59,90,120,151,181,212,243,273,304,334);
begin
DayNumber := DaysBeforeMonth[Month] + Day + Ord( (Month > 2) and
(Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)) ) ;
end;
function WeekNumber (Day, Month, Year : Integer ) : Integer;
begin
if (Month = 1) and (Day < FirstThursday(Year)-3) then
WeekNumber := WeekNumber(31,12,Pred(Year))
else
if (Month = 12) and (Day > FirstThursday(Succ(Year))+27) then
WeekNumber := 1
else
WeekNumber := (DayNumber(Day,Month,Year)-FirstThursday(Year)+10) div 7;
end;
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:33 1996
Subject: OutText, integers and reals
93. *****
Q: How can I use OutText to write numbers in the graphics mode?
A: OutText is the procedure to use for output in the graphics mode.
The syntax of the procedure is OutText(TextString: string). You'll
first have to convert a number into a string before you can output
it with OutText. The example below shows how it can be done when the
users wishes to output the integer value value of 12 and the result
of 4/7 as a real with a suitable formatting. Generalization from
thereon should be easy.
uses Crt, Graph;
var grDriver : integer;
grMode : integer;
ErrCode : integer;
const CharSize : integer = 2;
{}
function INT2STR (x : integer; ff : byte) : string;
var s : string;
begin
Str (x : ff, s);
int2str := s;
end;
{}
function REAL2STR (x : real; ff, dd : byte) : string;
var s : string;
begin
Str (x : ff : dd, s);
real2str := s;
end;
{}
begin
grDriver := Detect;
InitGraph (grDriver, grMode, ' ');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
SetColor (LightCyan);
SetBkColor (Black);
SetTextStyle(DefaultFont, HorizDir, CharSize);
{}
{... this is the example's key line ...}
OutText ('The values are: ' + INT2STR(12,2) + REAL2STR(4/7,10,3));
{}
MoveTo (0, 10*CharSize);
OutText ('Press any key');
repeat until KeyPressed;
RestoreCrtMode;
CloseGraph;
end.
Naturally, the 12 in INT2STR(12,2) could as well be a variable
containing the value. Ditto for REAL2STR(4/7,10,3).
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:34 1996
Subject: Ctr and output redirection
94. *****
Q: How can I redirect output to file if I use the Crt unit?
A: First example:
uses Crt;
begin
writeln ('This output cannot be redireted');
assign (output, ''); { standard output }
rewrite (output);
writeln ('This output can be redirected');
end.
Second example:
uses Crt;
var f: Text;
begin
Assign (f, '');
Rewrite (f);
Writeln (f, 'This output can be redirected');
Close (f);
AssignCrt (f);
Rewrite (f);
Writeln (f, 'This output cannot be redirected');
Close(f);
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:35 1996
Subject: In text or graphics mode
95. *****
Q: How to write a function to return true if I am in graphics mode?
A: The ISGRFN in the example below returns true if the program
currently runs in the graphics mode and false in the text mode. For
more information see Ralf Brown's interrupt list part INTERRUP.A for
interrupt $10 functions $00 and $0F.
uses Dos, Crt, Graph;
(* The function to detect whether in video or text mode *)
function ISGRFN : boolean;
var regs : registers;
begin
FillChar (regs, SizeOf(regs), 0); { Just to make sure }
regs.ah := $0F; { Function $0F gets video mode }
Intr ($10, regs); { Call the video interrupt }
case regs.al of
$00,$01,$02,$03,$07 : isgrfn := false; { is in text mode }
else isgrfn := true; { is in graphics mode }
end; {case}
end; (* isgrfn *)
(* A procedure to turn the default graphics on *)
procedure GRAPHON;
var grDriver : integer;
grMode : integer;
ErrCode : integer;
begin
grDriver := Detect;
InitGraph (grDriver, grMode, ' ');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
ClearDevice;
end; (* graphon *)
(* Test in the text mode *)
procedure TEST1;
begin
if ISGRFN then
writeln ('In graphics mode')
else
writeln ('In text mode');
writeln ('Press any key');
repeat until KeyPressed; { allow seeing the result }
while KeyPressed do ReadKey; { clear typeahead buffer }
end; (* test1 *)
(* Test in the graphics mode *)
procedure TEST2;
begin
GRAPHON;
SetColor (Yellow);
SetBkColor (Black);
SetTextStyle (DefaultFont, HorizDir, 2);
if ISGRFN then
OutTextXY (100, 20, 'In graphics mode')
else
OutTextXY (100, 20, 'In text mode');
OutTextXY (100, 50, 'Press any key');
repeat until KeyPressed; { allow seeing the result }
while KeyPressed do ReadKey; { clear typeahead buffer }
RestoreCrtMode;
CloseGraph;
end; (* test2 *)
(* Main program *)
begin
TEST1;
TEST2;
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:36 1996
Subject: Lost my graph.tpu
96. *****
Q: My graph.tpu got corrupted. Someone please email me a new copy.
A: Then you should restore the unit from the Turbo Pascal
installation disks that came with the package when you bought it. If
you have TP 7.0, the GRAPH.TPU - Borland Graphics Interface (BGI)
Graph unit - is located on the installation disk #4.
This plea is being often presented on the Usenet Turbo Pascal
newsgroups. It coincides with reports of an incomplete pirate Turbo
Pascal copy in circulation. This fact explains why so often the user
has "lost" the installation disk ("my dog ate it", "my girl/
boyfriend borrowed/ate it", "I misplaced it in the student rally",
"I poured coffee/coke/ooze on it", "it was abducted by the aliens").
There is no reason why we should to compound the piracy by
consenting to these requests. In the (unlikely?) case that the
dilemma is honest, the user should contact his/her friendly vendor
to replace his/her damaged installation disk.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:37 1996
Subject: Numeric input errors
97. *****
Q: How can I avoid run-time errors in numeric input using readln?
A: The answer to this common question is to read the user's input
into a string first instead directly into the numeric variable(s).
As so often, the idea is best presented by a simple source code
example.
var x : real;
s, tx : string;
k : integer;
begin
repeat
tx := 'Give a number: ';
write (tx);
readln (s);
Val (s, x, k);
if k > 0 then writeln ('^':k+length(tx), #7);
until k = 0;
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:38 1996
Subject: Limited input
98. *****
Q: How can I limit the user's readln input to e.g. 3 characters?
A: Of course you could use the ordinary readln and check
afterwards, but if you wish to limit the length already at the time
the user types the input then you have to write an input routine of
your own. One way of doing that is to build a ReadKey loop with
editing capabilities. See the item "Turning off the input echo" in
this same FAQ for the basics.
However, there is a really neat solution using the MS-DOS
interrupt $21 buffered keyboard input function $0A. The solution was
posted by Osmo Ronkanen ronkanen@cc.helsinki.fi. It is given below.
I have made some minor changes in the original code.
uses Dos;
{}
Procedure BufferedInput (var st : string; max : byte);
var regs : registers;
buffer : record
maxlen : byte;
stb : string;
end;
begin
Buffer.Maxlen := max+1; { allow for the enter at the end }
regs.ds := Seg (buffer); { buffer address }
regs.dx := Ofs (buffer);
regs.ah := $0A;
MsDos (regs);
Move (Buffer.stb[0], st[0], Length(Buffer.stb)+1);
Writeln;
end;
{}
procedure TEST;
var s : string;
begin
Write ('Give your input: ');
BufferedInput (s, 3);
Writeln (s);
end;
{}
begin
TEST;
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:39 1996
Subject: Deleting a file
99. *****
Q: Can you tell a beginner how to delete files with Turbo Pascal?
A: A simple example code is give below
const filename = 'test.txt';
var f : file;
begin
Assign (f, filename);
{$I-} Erase(f); {$I+}
if IoResult = 0 then
writeln ('File ', filename, ' deleted')
else
writeln ('File ', filename, ' not found or protected');
end.
There is nothing wrong with asking, but the answer would have been
readily available on your manuals or even by using Turbo Pascal
IDE's help function. In fact, in Turbo Pascal 7.0 you can even get
an example by writing 'erase' in your program, moving the cursor on
the word and then by pressing ctrl-F1.
While we are at it, let consider slightly more advanced issues.
Let's say you need to delete a read-only file. The above code will
not delete such special files. The first thing you'll find useful to
be able to do is to test if a file exists and then if it is a
read-only file. Here are the relevant functions.
(* Does a file exist, detects also read-only, hidden and system files *)
function FEXIST (filename : string) : boolean;
var f : SearchRec;
begin
fexist := false;
FindFirst (filename, AnyFile, f);
if DosError = 0 then
if (f.attr and Directory = 0) and (f.attr and VolumeId = 0) then
fexist := true;
end; (* fexist *)
{}
(* Is the file a read-only file *)
function ISRDONLY (filename : string) : boolean;
var f : SearchRec;
begin
isrdonly := false;
FindFirst (filename, AnyFile, f);
if DosError = 0 then
if (f.attr and Directory = 0) and (f.attr and VolumeId = 0) and
(f.attr and ReadOnly > 0) then
isrdonly := true;
end; (* isrdonly *)
This, incidentally is not the only way to test. Below is another
example, this time showing how to detect if a file is a hidden file.
(* Is the file a hidden file, a slightly different method *)
function ISHIDDEN (filename : string) : boolean;
var f : file;
attr : word;
begin
Assign (f, filename);
GetFAttr (f, attr);
if DosError = 0 then
ishidden := attr and Hidden > 0
else
ishidden := false;
end; (* ishidden *)
Next, if tests showed that the file exists and that it is a
read-only file, you need to convert the read-only file back into an
ordinary file. Here is the routine.
(* Convert a read-only file into a normal file *)
procedure RDNORMAL (filename : string);
var f : file;
attr : word;
begin
Assign (f, filename);
GetFAttr (f, attr);
SetFAttr (f, attr and not readonly);
if DosError = 0 then
writeln ('Removed the read-only attribute from ', filename)
else
writeln ('Could not convert the read-only file ', filename);
end;
How to put this all together into a program that erases both normal
and read-only files is left as an exercise to the reader. All the
essential constituents have now been given.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Nov 9 00:01:40 1996
Subject: Shift operators shl and shr
100. *****
Q: Could you please explain shl and shr operators to a beginner?
A: Shl and shr perform bit operations on the integer type. They are
logical operators. In terms of a binary expression the former shifts
the bits of an integer to the left while shr shifts them to the
right.
To illustrate, think of the variable as a binary number instead
of a decimal. Consider for example
var x : word;
x := 219;
In binary presentation it is
The word 0000 0000 1101 1011
Position in the word FEDC BA98 7654 3210
If you perform a shift to the left by, for example by 2 steps,
you'll have
The word 0000 0011 0110 1100
Position in the word FEDC BA98 7654 3210
which in decimal terms is 876. In decimal TP notation this amounts
to the operation
var b : word;
b := x shl 2;
The value of b will be 876. Likewise, you can perform a shift to the
right. For example
b := x shr 1;
will be 109 because then you'll have
The word 0000 0000 0110 1101
Position in the word FEDC BA98 7654 3210
A question when and why this operation is needed has too varied an
answer to try to give it. However, there are several items in this
FAQ that show examples of factual usage of these operators in TP
programming tasks.
--------------------------------------------------------------------